home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-06-30 | 9.7 KB | 229 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10i.Scn.Fnt
- StampElems
- Alloc
- 3 May 95
- Syntax10b.Scn.Fnt
- Chicago10.Scn.Fnt
- MODULE DialogStaticTexts;
- (** Markus Knasm
- ller 22.Jun.94 -
- IMPORT DialogFrames, Dialogs, DialogTexts, Display, Display1, Files, Fonts, GraphicUtils, In, Oberon, TextFrames, Texts, Viewers;
- CONST MM = 1; W* = 40; H* = 20; CR = 0DX; black = 15;
- TYPE
- Item* = POINTER TO ItemDesc;
- ItemDesc* = RECORD(Dialogs.ObjectDesc)
- fnt-: Fonts.Font; (** the font with which the text is shown *)
- s-: ARRAY 64 OF CHAR; (** the text which is shown *)
- a-: INTEGER; (** alignment 0 = left 1 = center 2 = right see GraphicUtils *)
- END;
- VAR w0: Texts.Writer;
- PROCEDURE (t: Item) Draw* (x, y: INTEGER; f: Display.Frame);
- (** displays the object at (x, y) in frame f *)
- VAR ox, oy, w, h, yh, cx, mode: INTEGER;
- BEGIN
- t.GetDim (ox, oy, w, h);
- IF t.selected THEN
- mode := Display.invert;
- Display1.Line (f, black, x, y, x, y + h - 1, mode);
- Display1.Line (f, black, x, y, x + w - 1, y, mode);
- Display1.Line (f, black, x + w - 1, y, x + w - 1, y + h - 1, mode);
- Display1.Line (f, black, x, y + h - 1, x + w - 1, y + h - 1, mode)
- ELSE
- mode := Display.paint
- END;
- yh := y + (h DIV 2) - ((t.fnt.minY + t.fnt.maxY) DIV 2);
- IF h - (yh - y) > t.fnt.maxY THEN GraphicUtils.DrawString (f, t.s, x+ 3, yh, w - 4, t.fnt, mode, t.a, cx) END;
- END Draw;
- PROCEDURE (t: Item) Copy* (VAR dup: Dialogs.Object);
- (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
- VAR x: Item;
- BEGIN
- IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END;
- t.Copy^ (dup); x.fnt := t.fnt; COPY (t.s, x.s); x.a := t.a
- END Copy;
- PROCEDURE (t: Item) Load* (VAR r: Files.Rider);
- (** reads the object from rider r *)
- VAR fntname: ARRAY 32 OF CHAR; ch: CHAR; pos: LONGINT;
- BEGIN
- t.Load^ (r); pos := Files.Pos (r); Files.Read (r, ch);
- IF ch = 1X THEN (* new version *)
- Files.ReadInt (r, t.a);
- ELSE
- Files.Set (r, Files.Base (r), pos); t.a := GraphicUtils.center
- END;
- Files.ReadString (r, fntname); t.fnt := Fonts.This (fntname); Files.ReadString (r, t.s)
- END Load;
- PROCEDURE (t: Item) Store* (VAR r: Files.Rider);
- (** writes the object to rider r *)
- BEGIN t.Store^ (r); Files.Write (r, 1X); Files.WriteInt (r, t.a); Files.WriteString (r, t.fnt.name); Files.WriteString (r, t.s);
- END Store;
- PROCEDURE (t: Item) Print* (x, y: INTEGER);
- (** prints the object at printer coordinates (x, y) *)
- VAR w, h, ox, oy, yh, cx: INTEGER;
- BEGIN
- t.GetPDim (ox, oy, w, h);
- cx := (t.fnt.minY + t.fnt.maxY) DIV 2; cx := SHORT (cx * Dialogs.dUnit DIV Dialogs.pUnit);
- yh := y + (h DIV 2) - cx;
- IF h - (yh - y) > t.fnt.maxY THEN GraphicUtils.PrintString (t.s, x + 3, yh, w- 4, t.fnt, t.a, cx) END
- END Print;
- PROCEDURE (t: Item) SetFont* (fnt: Fonts.Font);
- (** sets the font with which the text is shown *)
- BEGIN t.Hide; t.fnt := fnt; t.Restore; IF t.panel # NIL THEN t.panel.MarkMenu END
- END SetFont;
- PROCEDURE (t: Item) SetString* (s: ARRAY OF CHAR);
- (** sets the text which is shown *)
- BEGIN t.Hide; COPY (s, t.s); t.Restore; IF t.panel # NIL THEN t.panel.MarkMenu END
- END SetString;
- PROCEDURE (t: Item) SetAlign* (a: INTEGER);
- (** sets the alignment of the string 0 = left 1 = center 2 = right *)
- BEGIN t.Hide; t.a := a; t.Restore; IF t.panel # NIL THEN t.panel.MarkMenu END
- END SetAlign;
- PROCEDURE (t: Item) Handle* (f: Display.Frame; VAR m: Display.FrameMsg);
- (** handles messages which were sent to frame f *)
- VAR t1: Texts.Text;
- BEGIN
- t.Handle^ (f, m);
- WITH f: DialogFrames.Frame DO
- WITH m: Oberon.InputMsg DO
- IF m.id = Oberon.track THEN
- IF (m.keys = {MM}) & (t.cmd[0] # 0X) THEN
- DialogTexts.GetParText (t.par, t.panel, t1);
- t.CallCmd (f, Viewers.This (m.X, m.Y), t1)
- ELSE Oberon.DrawCursor (Oberon.Mouse, Oberon.Arrow, m.X, m.Y)
- END
- END
- ELSE
- END
- ELSE
- END
- END Handle;
- PROCEDURE WriteToObjectStr (o: DialogTexts.Item; n: ARRAY OF CHAR);
- VAR t: Texts.Text;
- BEGIN
- t := o.GetText (); Texts.WriteString (w0, n); Texts.Append (t, w0.buf);
- END WriteToObjectStr;
- PROCEDURE WriteToObjectInt (o: DialogTexts.Item; n: INTEGER);
- VAR t: Texts.Text;
- BEGIN
- t := o.GetText (); Texts.WriteInt (w0, n, 0); Texts.Append (t, w0.buf);
- END WriteToObjectInt;
- PROCEDURE (t: Item) Edit*;
- (** opens a dialog for editing the properties of the object *)
- VAR
- on: Dialogs.Object; os, string, align: DialogTexts.Item; s: Item; p: Dialogs.Panel;
- t1: Texts.Text; fnt: Fonts.Font; st: ARRAY 16 OF CHAR;
- BEGIN
- t.Edit^ (); p := Dialogs.editPanel;
- NEW (string); string.Init;
- string.SetName ("string"); string.SetDim (245, -30, 140, 19, FALSE); p.Insert (string, FALSE);
- (* ---- *) ASSERT (Dialogs.res = Dialogs.ok);
- NEW (s); s.Init; s.SetDim (196, -30, 40, 20, FALSE);
- s.SetString ("String"); fnt := Fonts.This ("Syntax10.Scn.Fnt"); s.SetFont (fnt);
- p.Insert (s, FALSE);
- (* ---- *) ASSERT (Dialogs.res = Dialogs.ok);
- NEW (s); s.Init; s.SetDim (2, - 176, 35, 20, FALSE);
- s.SetString ("Align"); fnt := Fonts.This ("Syntax10.Scn.Fnt"); s.SetFont (fnt);
- p.Insert (s, FALSE);
- (* ---- *) ASSERT (Dialogs.res = Dialogs.ok);
- NEW (align); align.Init;
- align.SetName ("align"); align.SetDim (38, - 176, 40, 19, FALSE); p.Insert (align, FALSE);
- (* ---- *) ASSERT (Dialogs.res = Dialogs.ok);
- WriteToObjectStr (string, t.s);
- t1 := string.GetText (); Texts.ChangeLooks (t1, 0, t1.len, {0}, t.fnt, 0, 0);
- IF t.a = 0 THEN COPY ("left", st);
- ELSIF t.a = 1 THEN COPY ("center", st);
- ELSE COPY ("right", st)
- END;
- WriteToObjectStr (align, st);
- END Edit;
- PROCEDURE (t: Item) Update* (p: Dialogs.Panel);
- (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
- VAR os: Dialogs.Object; t1: Texts.Text; r: Texts.Reader; ch: CHAR; str: ARRAY 64 OF CHAR; i: INTEGER; s: Texts.Scanner;
- BEGIN
- t.Update^ (p);
- os := p.NamedObject ("string"); t1 := os(DialogTexts.Item).GetText ();
- Texts.OpenReader (r, t1, 0); Texts.Read (r, ch); i := 0;
- IF (r.fnt # NIL) & (r.fnt # t.fnt) THEN t.SetFont (r.fnt) END;
- WHILE ~ r.eot DO
- str[i] := ch; INC (i); Texts.Read (r, ch);
- END;
- str[i] := 0X;
- IF str # t.s THEN t.SetString (str) END;
- os := p.NamedObject ("align"); t1 := os(DialogTexts.Item).GetText ();
- Texts.OpenScanner (s, t1, 0); Texts.Scan (s);
- IF s.class = Texts.Int THEN i := SHORT (s.i)
- ELSIF s.class = Texts.Name THEN
- IF s.s[0] = "l" THEN i := GraphicUtils.left
- ELSIF s.s[0] = "c" THEN i := GraphicUtils.center
- ELSE i := GraphicUtils.right
- END
- ELSE i := GraphicUtils.center END;
- IF i # t.a THEN t.a := i; t.Hide; t.Restore END
- END Update;
- PROCEDURE Insert*;
- (** Insert ([name] [x y w h] | ^ ) inserts a static text - item in the panel containing the caret position *)
- VAR x, y, x1, y1, w, h: INTEGER; t: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; r: Texts.Reader; ch: CHAR;
- BEGIN
- NEW (t);
- DialogFrames.GetCaretPosition(p, x, y);
- IF (p # NIL) THEN
- t.Init; t.fnt := Fonts.This ("Syntax10.Scn.Fnt");
- In.Open; Texts.OpenReader (r, Oberon.Par.text, 0); Texts.Read (r, ch);
- In.Name (name);
- IF ~In.Done THEN COPY ("", name); In.Open ELSE t.fnt := r.fnt END;
- COPY (name, t.s); t.SetName (name);
- In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
- IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H
- ELSE
- IF w < 0 THEN w := W END;
- IF h < 0 THEN h := H END
- END;
- y := GraphicUtils.GetStringLength (name, t.fnt) + 5;
- IF y > w THEN x := w; w := y END;
- t.SetDim (x1, y1, w, h, FALSE); t.a := GraphicUtils.center; p.Insert (t, FALSE);
- IF Dialogs.res = Dialogs.objectWouldOverlap THEN
- t.SetDim (x1, y1, y, h, FALSE); p.Insert (t, FALSE)
- END
- ELSE
- Dialogs.res := Dialogs.noPanelSelected
- END;
- IF Dialogs.res # 0 THEN Dialogs.Error ("DialogStaticTexts") END;
- END Insert;
- PROCEDURE SetString*;
- (** SetString ({ch} | ^) sets the string of the static text item at the caret to str *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR; ch: CHAR; i: INTEGER;
- BEGIN
- In.Open; In.Char (ch); i := 0;
- WHILE In.Done & (ch = " ") DO In.Char (ch) END; (* skip leading blanks *)
- IF ~ In.Done THEN
- Dialogs.res := Dialogs.wrongInput
- ELSE
- WHILE In.Done & (ch # CR) & (ch # "~") & (i < 63) DO str[i] := ch; INC (i); In.Char (ch) END;
- str[i] := 0X;
- DialogFrames.FindObject (o, p);
- IF (Dialogs.res = Dialogs.ok) & (o IS Item) THEN
- o(Item).SetString (str); o(Item).SetFont (Fonts.This ("Syntax10.Scn.Fnt"))
- END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogStaticTexts") END
- END SetString;
- PROCEDURE GetString*;
- (** writes the component s of the static text item under the caret to the log viewer *)
- VAR o: Dialogs.Object; p: Dialogs.Panel; str: ARRAY 64 OF CHAR;
- BEGIN
- DialogFrames.FindObject (o, p);
- IF Dialogs.res = Dialogs.ok THEN
- IF o IS Item THEN
- COPY (o(Item).s, str);
- Texts.WriteString (w0, "String:"); Texts.WriteString (w0, str); Texts.WriteLn (w0);
- Texts.Append (Oberon.Log, w0.buf)
- ELSE
- Dialogs.res := Dialogs.objectNotFound
- END
- END;
- IF Dialogs.res # Dialogs.ok THEN Dialogs.Error ("DialogStaticTexts") END
- END GetString;
- BEGIN Texts.OpenWriter (w0)
- END DialogStaticTexts.
-